(************************************************************************)
(*  Copyright(c) Filip Lundeholm 2010                                   *)
(*          All Rights Reserved                                         *)
(*                                                                      *)
(*  Revision History:                                                   *)
(*    2010-11-03    v0.2:   first public version                        *)
(************************************************************************)

unit psopas_particle;

{$mode objfpc}{$H+}

interface

uses Classes, SysUtils, Math, psopas_variable;

const
  maxInertia = 1.4;
  minInertia = 0.3;


type
  TDoubleArray = array of double;
  { TParticle }

  TParticle = class
  private
    FPos, FSpeed, FPersonalBest: TDoubleArray;
    FFitness, FBestFitness: double;
    FInertiaFactor, FInertia: double;
    FVariables: TVariableList;
    procedure init();
  public
    constructor Create(variables: TVariableList; maxIterations: integer); overload;
    destructor Destroy(); overload;

    function getFitness(): double;
    procedure setFitness(fitnessValue: double);
    procedure setInertiaFactor(Value: double);
    procedure update(const swarmBestPos: TDoubleArray);
    procedure updateInertia();
    function getPosition: TDoubleArray;
    procedure getPosition(out target: TDoubleArray);
  end;

implementation

constructor TParticle.Create(variables: TVariableList; maxIterations: integer);
begin
  FVariables  := variables;
  FFitness     := Math.MinDouble;
  FBestFitness := Math.MinDouble;
  SetLength(FPos, FVariables.Count);
  SetLength(FSpeed, FVariables.Count);
  SetLength(FPersonalBest, FVariables.Count);

  FInertia := maxInertia;
  FInertiaFactor := Math.power(minInertia / maxInertia, 1.0 / maxIterations);

  init();
end;

destructor TParticle.Destroy();
begin
  SetLength(FPos, 0);
  SetLength(FSpeed, 0);
  SetLength(FPersonalBest, 0);
  inherited Destroy;
end;

procedure TParticle.setInertiaFactor(Value: double);
begin
  FInertiaFactor := Value;
end;

procedure TParticle.init();
var
  i: integer;
  v: TVariable;
begin
  for i := 0 to FVariables.Count - 1 do
  begin
    v := TVariable(FVariables[i]);

    // init speed and pos
    FPos[i] := v.AdjustedMin + random() * (v.AdjustedMax - v.AdjustedMin);
    FSpeed[i] := -0.5 * (v.AdjustedMax - v.AdjustedMin) + random() *
      (v.AdjustedMax - v.AdjustedMin);
  end;
end;

procedure TParticle.update(const swarmBestPos: TDoubleArray);
var
  i: integer;
  cognitive, maxSpeed, social: double;
  v: TVariable;
begin
  for i := 0 to FVariables.Count - 1 do
  begin
    v      := TVariable(FVariables[i]);
    // update FSpeed
    cognitive := 2 * random() * (FPersonalBest[i] - FPos[i]);
    social := 2 * random() * (swarmBestPos[i] - FPos[i]);
    FSpeed[i] := FSpeed[i] + cognitive + social;

    maxSpeed := v.AdjustedMax - v.AdjustedMin;

    // limit FSpeed
    if abs(FSpeed[i]) > maxSpeed then
    begin
      FSpeed[i] := maxSpeed * Math.sign(FSpeed[i]);
    end;

    // update FPos
    FPos[i] := FPos[i] * FInertia + FSpeed[i];

    //limit FPos by randomizing trespassers
    if FPos[i] >= v.AdjustedMax then
    begin
      FPos[i] := random() * maxSpeed + v.AdjustedMin;
    end;

    if FPos[i] <= v.AdjustedMin then
    begin
      FPos[i] := random() * maxSpeed + v.AdjustedMin;
    end;
  end;

  //update FInertia
  updateInertia();
end;

procedure TParticle.updateInertia();
begin
  FInertia := FInertia * FInertiaFactor;
  FInertia := Math.max(minInertia, FInertia);
end;

function TParticle.getPosition(): TDoubleArray;
begin
  Result := FPos;
end;

procedure TParticle.getPosition(out target: TDoubleArray);
var
  i: integer;
begin
  SetLength(target, length(FPos));

  for i := 0 to length(FPos) - 1 do
  begin
    target[i] := FPos[i];
  end;
end;

procedure TParticle.setFitness(fitnessValue: double);
begin
  FFitness := fitnessValue;

  if FFitness > FBestFitness then
  begin
    FBestFitness := fitnessValue;
    getPosition(FPersonalBest);
  end;
end;

function TParticle.getFitness(): double;
begin
  Result := FFitness;
end;

end.

